9  Online Appendix B

9.1 Setup

9.1.1 Install Packages

We install the following packages using the groundhog package manager to increase computational reproducibility.

if (!requireNamespace("groundhog", quietly = TRUE)) {
    install.packages("groundhog")
}

pkgs <- c("magrittr", "data.table", "stringr", "lubridate", "knitr", "glue",
          "sandwich", "lmtest",
          "ggplot2", "ggpubr", "rstatix", "patchwork")

groundhog::groundhog.library(pkg = pkgs,
                             date = "2024-08-01")

rm(pkgs)

9.1.2 Read Data

# data <- data.table::fread(file = "../data/processed/full.csv")
data <- readRDS(file="../data/processed/full.Rda")

9.1.3 Design

We define some design features in the following:

colors <- c("#F3B05C", "#1E4A75", "#65B5C0", "#AD5E21")

layout <- theme(panel.background = element_rect(fill = "white"),
                legend.key = element_rect(fill = "white"),
                panel.grid.major.y = element_line(colour = "grey", 
                                                  linewidth = 0.25),
                axis.ticks.y = element_blank(),
                panel.grid.major.x = element_blank(),
                axis.line.x.bottom = element_line(colour = "#000000", 
                                                  linewidth = 0.5),
                axis.line.y.left = element_blank(),
                plot.title = element_text(size = rel(1))
)

9.1.4 Helper Function

plot_bars <- function(response = "b", surprise_sub = NA, limits = ylim(-0.1, 100.1)){
  
  if(response == "b"){
      y_1 = 75
      y_2 = 55
    } else {
      y_1 = 75
      y_2 = 60
    }
  
  if(!is.na(surprise_sub)){
    # Plot bottom panels
    tmp <- data[surprise == surprise_sub]
    names(tmp)[names(tmp) == response] <- 'outcome'
    
    if(surprise_sub){
      title <- "Surprising Condition"
    } else {
      title <- "Confirming Condition"
    }
    
    test_stats_1 <- tmp %>% 
      group_by(communication) %>%
      wilcox_test(formula = outcome ~ stage,
                  paired = T) %>% 
      adjust_pvalue(method = "none") %>%
      add_significance(p.col = "p.adj",
                       cutpoints = c(0, 0.01, 0.05, 0.1, 1),
                       symbols = c( "***", "**", "*", "ns")) %>%
      as.data.table()
    
    
    test_stats_2 <- tmp %>% 
      group_by(stage) %>%
      wilcox_test(formula = outcome ~ communication) %>% 
      adjust_pvalue(method = "none") %>%
      add_significance(p.col = "p.adj",
                       cutpoints = c(0, 0.01, 0.05, 0.1, 1),
                       symbols = c( "***", "**", "*", "ns")) %>%
      as.data.table()
    test_stats_2 <- test_stats_2[stage == 2]
    
    plot_bottom <- ggplot(data = tmp,
           mapping = aes(x = as.factor(communication),
                         y = outcome)) +
        geom_bar(aes(fill = stage),
                 position = "dodge", 
                 stat = "summary", 
                 fun = "mean") + 
      limits +
      scale_fill_manual(values=c("black", "gray")) +
      theme_classic() +
      stat_pvalue_manual(data = test_stats_2,
                         label = "{p} ({p.adj.signif})", 
                         step.group.by = "stage",
                         tip.length = 0, 
                         step.increase = 0.1, 
                         y.position = y_1) +
      stat_pvalue_manual(data = test_stats_1,
                         label = "{p} ({p.adj.signif})",
                         y.position = y_2,
                         tip.length = 0,
                         x = "communication") +
      labs(title = "",
           x = " Surprising Condition",
           y = glue(" {response}"))
    
    rm(tmp)
    
    plot_bottom
  } else {
    # Plot the top panel
    tmp <- data
    names(tmp)[names(tmp) == response] <- 'outcome'
    
    title <- "Both Conditions"
    
    test_stats_1 <- tmp %>% 
      group_by(surprise) %>%
      wilcox_test(formula = outcome ~ stage,
                  paired = T) %>% 
      adjust_pvalue(method = "none") %>%
      add_significance(p.col = "p.adj",
                       cutpoints = c(0, 0.01, 0.05, 0.1, 1),
                       symbols = c( "***", "**", "*", "ns")) %>%
      as.data.table()
    
    
    test_stats_2 <- tmp %>% 
      group_by(stage) %>%
      wilcox_test(formula = outcome ~ surprise) %>% 
      adjust_pvalue(method = "none") %>%
      add_significance(p.col = "p.adj",
                       cutpoints = c(0, 0.01, 0.05, 0.1, 1),
                       symbols = c( "***", "**", "*", "ns")) %>%
      as.data.table()
    test_stats_2 <- test_stats_2[stage == 2]
    
    
    plot_top <- ggplot(data = tmp,
           mapping = aes(x = as.factor(surprise),
                         y = outcome)) +
        geom_bar(aes(fill = stage),
                 position = "dodge", 
                 stat = "summary", 
                 fun = "mean") + 
      limits +
      scale_fill_manual(values=c("black", "gray")) +
      theme_classic() +
      stat_pvalue_manual(data = test_stats_2,
                         label = "{p} ({p.adj.signif})", 
                         step.group.by = "stage",
                         tip.length = 0, 
                         step.increase = 0.1, 
                         y.position = y_1) +
      stat_pvalue_manual(data = test_stats_1,
                         label = "{p} ({p.adj.signif})",
                         y.position = y_2,
                         tip.length = 0,
                         x = "surprise") +
      labs(title = "",
           x = " Surprising Condition",
           y = glue(" {response}"))
    
    rm(tmp)
    
    plot_top
  }
}

9.2 Figure OB.1

To create Figure 9.1 (and the other figures), we use the wrapper function defined above. We’ll call several times in what follows. As all the other figures presented in this document, Figure 9.1 consists of three panels, top, left, and right that are relatively similar. We thus, save both space and sources of error by creating a wrapper function plot_bars() that creates bar plots and annotates them with test statistics.

top   <- plot_bars(response = "E1", surprise_sub = NA)
left  <- plot_bars(response = "E1", surprise_sub = FALSE)
right <- plot_bars(response = "E1", surprise_sub = TRUE)

(top / (left | right) & theme(legend.position = "bottom")) + plot_layout(guides = "collect")

Figure 9.1: Means of the matching probabilities for event E1 separated by treatments and part 1 and part 2. P-values of Wilcoxon signed-rank test comparing part 1 and 2 directly above the mean values. P-values of Wilcoxon–Mann–Whitney test comparing part 2 of different treatments at the top. Note: ∗p<0.10, ∗∗p<0.05, ∗∗∗p<0.01, ns: not significant

9.3 Figure OB.2

Next, we use the wrapper function again but visualize another outcome using the response == E2 argument.

top   <- plot_bars(response = "E2", surprise_sub = NA)
left  <- plot_bars(response = "E2", surprise_sub = FALSE)
right <- plot_bars(response = "E2", surprise_sub = TRUE)

(top / (left | right) & theme(legend.position = "bottom")) + plot_layout(guides = "collect")

Figure 9.2: Means of the matching probabilities for event E2 separated by treatments and part 1 and part 2. P-values of Wilcoxon signed-rank test comparing part 1 and 2 directly above the mean values. P-values of Wilcoxon–Mann–Whitney test comparing part 2 of different treatments at the top. Note: ∗p<0.10, ∗∗p<0.05, ∗∗∗p<0.01, ns: not significant

9.4 Figure OB.3

Next, we use the wrapper function again but visualize another outcome using the response == E3 argument.

top   <- plot_bars(response = "E3", surprise_sub = NA)
left  <- plot_bars(response = "E3", surprise_sub = FALSE)
right <- plot_bars(response = "E3", surprise_sub = TRUE)

(top / (left | right) & theme(legend.position = "bottom")) + plot_layout(guides = "collect")

Figure 9.3: Means of the matching probabilities for event E3 separated by treatments and part 1 and part 2. P-values of Wilcoxon signed-rank test comparing part 1 and 2 directly above the mean values. P-values of Wilcoxon–Mann–Whitney test comparing part 2 of different treatments at the top. Note: ∗p<0.10, ∗∗p<0.05, ∗∗∗p<0.01, ns: not significant

9.5 Figure OB.4

Next, we use the wrapper function again but visualize another outcome using the response == E12 argument.

top   <- plot_bars(response = "E12", surprise_sub = NA)
left  <- plot_bars(response = "E12", surprise_sub = FALSE)
right <- plot_bars(response = "E12", surprise_sub = TRUE)

(top / (left | right) & theme(legend.position = "bottom")) + plot_layout(guides = "collect")

Figure 9.4: Means of the matching probabilities for event E12 separated by treatments and part 1 and part 2. P-values of Wilcoxon signed-rank test comparing part 1 and 2 directly above the mean values. P-values of Wilcoxon–Mann–Whitney test comparing part 2 of different treatments at the top. Note: ∗p<0.10, ∗∗p<0.05, ∗∗∗p<0.01, ns: not significant

9.6 Figure OB.5

Next, we use the wrapper function again but visualize another outcome using the response == E13 argument.

top   <- plot_bars(response = "E13", surprise_sub = NA)
left  <- plot_bars(response = "E13", surprise_sub = FALSE)
right <- plot_bars(response = "E13", surprise_sub = TRUE)

(top / (left | right) & theme(legend.position = "bottom")) + plot_layout(guides = "collect")

Figure 9.5: Means of the matching probabilities for event E13 separated by treatments and part 1 and part 2. P-values of Wilcoxon signed-rank test comparing part 1 and 2 directly above the mean values. P-values of Wilcoxon–Mann–Whitney test comparing part 2 of different treatments at the top. Note: ∗p<0.10, ∗∗p<0.05, ∗∗∗p<0.01, ns: not significant

9.7 Figure OB.6

Next, we use the wrapper function again but visualize another outcome using the response == E23 argument.

top   <- plot_bars(response = "E23", surprise_sub = NA)
left  <- plot_bars(response = "E23", surprise_sub = FALSE)
right <- plot_bars(response = "E23", surprise_sub = TRUE)

(top / (left | right) & theme(legend.position = "bottom")) + plot_layout(guides = "collect")

Figure 9.6: Means of the matching probabilities for event E23 separated by treatments and part 1 and part 2. P-values of Wilcoxon signed-rank test comparing part 1 and 2 directly above the mean values. P-values of Wilcoxon–Mann–Whitney test comparing part 2 of different treatments at the top. Note: ∗p<0.10, ∗∗p<0.05, ∗∗∗p<0.01, ns: not significant

Session Info

sessionInfo()

R version 4.4.1 (2024-06-14)
Platform: x86_64-apple-darwin20
Running under: macOS Sonoma 14.4.1

Matrix products: default
BLAS:   /Library/Frameworks/R.framework/Versions/4.4-x86_64/Resources/lib/libRblas.0.dylib 
LAPACK: /Library/Frameworks/R.framework/Versions/4.4-x86_64/Resources/lib/libRlapack.dylib;  LAPACK version 3.12.0

locale:
[1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8

time zone: Europe/Zurich
tzcode source: internal

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods   base     

other attached packages:
 [1] patchwork_1.2.0   rstatix_0.7.2     ggpubr_0.6.0      ggplot2_3.5.1    
 [5] lmtest_0.9-40     zoo_1.8-12        sandwich_3.1-0    glue_1.7.0       
 [9] knitr_1.48        lubridate_1.9.3   stringr_1.5.1     data.table_1.15.4
[13] magrittr_2.0.3   

loaded via a namespace (and not attached):
 [1] utf8_1.2.4        generics_0.1.3    tidyr_1.3.1       stringi_1.8.4    
 [5] lattice_0.22-6    digest_0.6.36     evaluate_0.24.0   grid_4.4.1       
 [9] timechange_0.3.0  fastmap_1.2.0     jsonlite_1.8.8    backports_1.5.0  
[13] groundhog_3.2.0   purrr_1.0.2       fansi_1.0.6       scales_1.3.0     
[17] abind_1.4-5       cli_3.6.3         rlang_1.1.4       munsell_0.5.1    
[21] withr_3.0.1       yaml_2.3.10       tools_4.4.1       parallel_4.4.1   
[25] ggsignif_0.6.4    dplyr_1.1.4       colorspace_2.1-1  broom_1.0.6      
[29] vctrs_0.6.5       R6_2.5.1          lifecycle_1.0.4   car_3.1-2        
[33] htmlwidgets_1.6.4 pkgconfig_2.0.3   pillar_1.9.0      gtable_0.3.5     
[37] xfun_0.46         tibble_3.2.1      tidyselect_1.2.1  rstudioapi_0.16.0
[41] farver_2.1.2      htmltools_0.5.8.1 labeling_0.4.3    carData_3.0-5    
[45] rmarkdown_2.27    compiler_4.4.1